home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / pascal / ztfdd.exe / ZTFDD.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1991-08-09  |  1.9 KB  |  78 lines
  1. UNIT ztfdd;
  2.  
  3. { A Text File Device Driver whose formatted output is a PChar
  4.  
  5.   Usage:
  6.     Include the ZTFDD unit in your program's "Uses" clause.
  7.     Write(Zout, ..Anything that can be used with Write()..);
  8.     The resulting PChar output can be retreived with function GetZ.
  9.     See ZFDDTEST.PAS for a usage example.
  10.  
  11.   Notes:
  12.     There is no need to Assign, Rewrite, or Close "Zout".
  13.  
  14.     Don't use WriteLn(Zout,..) unless you want the PChar to end with ^M^J
  15.  
  16.     The maximum length of the resulting PChar is 127.  That can be easily
  17.     modified by creating a larger buffer and setting BufPtr and BufSize
  18.     in InitTFDD().
  19. }
  20.  
  21. {-------------------------------}
  22. Interface
  23. {-------------------------------}
  24. uses windos;
  25.  
  26. var
  27.   ZOut : text;    { text file to Write() to }
  28.  
  29. function GetZ : PChar;
  30.   { returns PChar() result from previous Write(Zout,,)}
  31.  
  32. {-------------------------------}
  33. Implementation
  34. {-------------------------------}
  35.  
  36. function GetZ : PChar;
  37. begin
  38.   getz := PChar(ttextrec(ZOut).BufPtr);
  39. end;
  40.  
  41. Function OpenProc(VAR F : TTextRec) : Integer; far;
  42. { initialize Zout for output }
  43. BEGIN
  44.   OpenProc := 0;
  45.   F.mode := fmOutput;
  46.   F.BufPos := 0;
  47. END;
  48.  
  49. { TFDD InOut function }
  50. Function ZTFDDout(VAR F : TTextRec) : Integer; far;
  51. BEGIN
  52.   { make bufptr^ an asciiz }
  53.   if (f.bufpos = f.bufsize) then dec(f.bufpos);
  54.   f.bufptr^[f.bufpos] := #0;
  55.   f.BufPos := 0;    { reset bufpos for next Write() }
  56.   ZTFDDout := 0;    { Set IoResult code }
  57. END;
  58.  
  59. Procedure InitTFDD(VAR F : Text);
  60. { Initialize TFDD TTextRec, and open it for output }
  61. BEGIN
  62.   With TTextRec(F) Do BEGIN
  63.     Handle := 0;
  64.     mode := fmClosed;
  65.     BufSize := sizeof(ttextbuf);
  66.     BufPtr := @Buffer;
  67.     BufPtr^[0] := #0;
  68.     OpenFunc := @OpenProc;
  69.     InOutFunc := @ZTFDDout;
  70.     FlushFunc := @ZTFDDout;
  71.   END;
  72.   ReWrite(F);
  73. END;
  74.  
  75. BEGIN
  76.   InitTFDD(Zout);    { Open Zout TFDD }
  77. END.
  78.